package Sgdb::Cntr::BranchProf;

require Tk::LabFrame;
require Tk::LabEntry;
use Tk::TableMatrix;

use Sgdb::Utils qw( :DEFAULT
                    localconfig
                    isbusy
                    bypass_busy_for_interrupter
                    gdb_source_map
                    gdb_func_map
                    target_symmetrix_chdir
                    target_symmetrix_list
                    );

use warnings;
use strict;
use integer;
use bytes;

my $samples_count;
my $state;
my $available_data;
my $analyze_mode = 1;
my $multi_dir;
my $samples_type = 0;
my @samples;
my @symbols;
my $result_tbl;
my $data_filter = '';
my $online_collect = 'Read';

init ();

sub init {
    samples_count();
    1;
}

sub samples_count {
    my $num = @samples;
    $samples_count = $num || "no samples";
    $num
}

sub new {
    my $self = shift or die 'whoami';
    my $topf = shift or die 'no topf';
    my @prefL = pref 'profiler-pane-label';
    my @prefB = pref 'profiler-pane-button';
    my @prefE = pref 'profiler-pane-entry';

    my $f;
    my $ft = $topf->Frame (-bg=>$topf->cget ('-bg')
                          )->pack qw(-side top -anchor nw);
    my @bg =('-background', $ft->cget('-background'));

    $f = $ft->LabFrame(-label=>'Profiling:', -labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>0,-sticky=>'ns',-padx=>5);

    balloonset <<DoC =>
Start collecting branch
profile data on Symmetrix.
Clear the buffer first.
DoC
     $f->Button (-text=>'Start',
                 -command=>\&online_collect_start,
                 @prefB
                )->grid(-row=>0,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Stop buffering branch
profile data on Symmetrix.
DoC
    $f->Button (-text=>'Stop',
                -command=>\&online_collect_stop,
                @prefB
               )->grid(-row=>1,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Buffer branch profile
data from multiple
targets. Target emulations
must be of the same
kind (d61f,s61e..)!
DoC
    $f->Checkbutton (-variable=>\$multi_dir,
                     -text=>'Multi dir',
                    )->grid(-row=>0,-column=>1,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Continue collecting
without clearing the
buffer!
DoC
    $f->Button (-text=>'Continue',
                -command=>[\&online_collect_continue],
                @prefB
               )->grid(-row=>1,-column=>1,-sticky=>'ew',-pady=>2,-padx=>5);

    $f = $ft->LabFrame(-label=>'Status:',-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>1,-sticky=>'ns',-padx=>5);

    $f->Label (@prefL,-bg=>'white',-textvariable=>\$state,
              )->grid(-row=>0,-column=>0,-sticky=>'w',-padx=>5);

    bypass_busy_for_interrupter
    balloonset <<DoC =>
Read the branch profiling
state from Symmetrix.
DoC
    $f->Button (-text=>'Refresh',
                -command=>\&refresh_state,
                @prefB
               )->grid(-row=>1,-column=>0,-sticky=>'w',-padx=>5);

    $f->Label (@prefL,-bg=>'white',-textvariable=>\$available_data,
              )->grid(-row=>0,-column=>1,-rowspan=>2,-sticky=>'w',-padx=>5);

    $f = $ft->LabFrame(-label=>'Analyze by:',-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>2,-sticky=>'ns',-padx=>5);

    balloonset <<DoC =>
Sort collected branches
by function name.
DoC
    $f->Radiobutton (-text=>'function',
                     -value=>1,
                     -variable=>\$analyze_mode,
                     -command=>\&show_data,
                    )->grid(-row=>0,-column=>0,-sticky=>'w',-padx=>5);

    balloonset <<DoC =>
Sort collected branches
by source file name.
DoC
    $f->Radiobutton (-text=>'module',
                     -value=>2,
                     -variable=>\$analyze_mode,
                     -command=>\&show_data,
                    )->grid(-row=>1,-column=>0,-sticky=>'w',-padx=>5);

  balloonset <<DoC =>
The current number of
buffered branches.
These are the branches
whose bit in the branch
bitmap is set.
DoC

    $f = $ft->LabFrame(-label=>'Samples:',-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>3,-sticky=>'ns',-padx=>5);

    $f->Label (@prefL,-bg=>'white',-textvariable=>\$samples_count,
              )->grid(-row=>0,-column=>1,-sticky=>'w',-padx=>5);

    bypass_busy_for_interrupter
    balloonset <<DoC =>
Read the branch bitmap
from Symmetrix to
a local buffer.
DoC
    $f->Button (-text=>'Read',
                -command=>sub {online_collect(); show_data()},
                @prefB
               )->grid(-row=>0,-column=>0,-sticky=>'w',-padx=>5);

    balloonset <<DoC =>
Clear the branch
bitmap on Symmetrix.
DoC
    $f->Button (-text=>'Clear',
                -command=>sub { @samples = (); show_data(); samples_count() },
                @prefB
               )->grid(-row=>1,-column=>0,-sticky=>'w',-padx=>5);

    $f = $ft->LabFrame(-label=>'File:',-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>4,-sticky=>'ns',-padx=>5);

   balloonset <<DoC =>
Load a saved branch
profile log file.
DoC
    $f->Button (-text=>'Load',
                -command=>\&load_from_file,
                @prefB
               )->grid(-row=>0,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);

    balloonset <<DoC =>
Save collected branch profile logs
to a file! You can later forward
these logs and the symbol file to
another server (Upload to TC)
for further analysiss.
DoC
    $f->Button (-text=>'Save',
                -command=>\&save_to_file,
                @prefB
               )->grid(-row=>2,-column=>0,-sticky=>'ew',-pady=>2,-padx=>5);


    balloonset <<DoC =>
Close the Profiler pane.
DoC
    $ft->Button(@prefB,-text=>'Close',
                -command=>sub{online_collect_stop(); $topf->destroy},
               )->grid(-row=>0,-sticky=>'w',-column=>5);

    my $filter = $topf->LabEntry(-label=>'Filter',-labelPack=>[-side=>'left'],
                                 -textvariable=>\$data_filter,
                                 @prefE
                                )->pack(-fill=>'x',-expand=>0,-anchor=>'n',-side=>'top');

    my @pref_tablematrix  = pref 'profiler-pane-tablematrix';
    my $modules_data = {};

    balloonset <<DoC =>
Click on the column header
to sort table according
this column contents.
DoC
    my $mtf = $topf->Scrolled('TableMatrix',
                              @pref_tablematrix,
                              -titlerows=>1, -titlecols=>1,
                              -colstretchmode=>'unset',
                              -resizeborders=>'col',
                              -cols=>6,
                              -selectmode=>'extended',
                              -cache=>0,
                              -variable=>$modules_data
                             )->pack(-fill=>'both',-expand=>1,-anchor=>'n',-side=>'top');

    $result_tbl = $mtf->{SubWidget}->{'tablematrix'};
    $result_tbl->MouseWheelBind("Tk::TableMatrix");
    $result_tbl->tagConfigure('title', -fg=>'blue', -relief=>'sunken', -anchor=>'center');
    $result_tbl->rowHeight(0,2);
    $modules_data->{"0,1"} = ('',"Functions","Modules")[$analyze_mode];
    $modules_data->{"0,2"} = "%";
    $modules_data->{"0,3"} = ('',"Branch\nCount","Count")[$samples_type];
    $modules_data->{"0,4"} = "Start\nAddress";
    $modules_data->{"0,5"} = "End\nAddress",

    $result_tbl->{'sortcol'} = 1;
    $result_tbl->{'sortdir'} = 0;

	$result_tbl->bind('<ButtonRelease-1>',\&click_result_tbl);
	$result_tbl->bind('<Double-1>',\&double_click_result_tbl);
    $filter->bind('<KeyRelease>',\&show_data);

    $result_tbl->colWidth(0=>5, 3=>8, 4=>8, 5=>8);
    $result_tbl->colWidth(2=>(0,0,8)[$samples_type]);
    $result_tbl->tagConfigure('right', -anchor=>'e');
    $result_tbl->tagCol('right',2,3,4,5);

    refresh_state();
    $topf;
}

sub online_collect_start{
    return unless gdb_cached 'is-alive';
    gdb_exec "symm-profiler VA";
    refresh_state();
}

sub online_collect_continue {
    return unless gdb_cached 'is-alive';
    gdb_exec "symm-profiler VR";
    refresh_state();
}

sub online_collect_stop     {
    return unless gdb_cached 'is-alive';
    gdb_exec "symm-profiler VZ";
    refresh_state();
}

sub refresh_state {
    my $st = get_state();
    if (defined $st->{running}) {
        if ($st->{running}) {
            $state = 'Running';
        } else {
            $state = 'Not running';
        }
    }
    if (defined($st->{elapsed_secs}) && defined($st->{samples})) {
        $available_data = sprintf "Data: %d\nTime: %d s",$st->{samples},$st->{elapsed_secs};
    }
}

sub load_from_file {

    my $pref = 'last-branches-profile-filename';

    my $file = shift || find_file (0,
                                   'Load PC Samples From ..',
                                   pref $pref
                                  ) or return;

    return telthemloud "'$file' no such file " unless     -e  $file;
    return telthemloud "'$file' is a directory" if        -d  $file;
    return telthemloud "'$file' not text file" unless     -T  $file;

    open F, $file or return telthemloud "can't open $file: $!";

    pref_set $pref, $file;

    @samples = ();
    while (<F>) {
        if (/^\s*\#\s*samples_type\s*:\s*(\w+)/) {
            $samples_type = $1;
        }
        next if /^\s*[\#\=]/;
        my @sl = map { hex } split /\W+/;
        if ($samples_type == 1) {
            push @samples, @sl;
        } else {
            push @samples, \@sl;
        }
    }
    close F;
    samples_count();
    show_data()
}

sub save_to_file {

    return telthemloud "gdb isn't active" unless gdb_cached('is-alive');
    my $pref = 'last-branches-profile-filename';
    my $file = find_file (1,
                          'Save Branch Profile Logs',
                          pref $pref
                         ) or return;

    return telthemloud "can't open $file: $!" unless open F, ">$file";
    pref_set $pref, $file;

    my ($commitlevel) = localconfig('get-emc-syreninfo', gdb_cached 'file') =~ /^\s*PROJECT_CVS_COMMIT_LEVEL\s*\=\s*([\d\.]+)/m;
    $commitlevel &&= "\n# commit level : $commitlevel";

    print F
        "# file : ", gdb_cached ('file'),
      "\n# date : ", scalar (localtime),
      "\n# fixes: ", gdb_cached('syren-v') =~ /\"(.*)\"/,
      $commitlevel || '',
      "\n# user : ", $ENV{USER} || "unknown user",
      "\n# host : ", $ENV{HOST} || "unknown host",
      "\n# samples_type : ", $samples_type,
      "\n";

    foreach my $sample (@samples) {
        if ($samples_type == 1) {
            printf F "0x%x\n",$sample;
        } else {
            printf F "0x%x 0x%x\n",@{$sample};
        }
    }
    close F;
    $file
}

sub init_symbols {
    my $mode = shift;
    gdb_cached 'is-alive' or return telthemloud 'No Active Debugger';
    my $symfile = gdb_cached 'file' or return telthemloud 'No Symbol File';
    return 1 if (gdb_cached('branch-analyze-mode') || '') eq $analyze_mode;

    @symbols = ();

    if($mode == 1) {
        busy;
        my $map = gdb_func_map();
        @symbols = @{$map};
    } elsif ($mode == 2) {
        busy;
        my $map = gdb_source_map();
        while(my ($source,$v) = each(%{$map})) {
            my ($addr,$len,$ver,$tag,$status,$alias) = @$v;
            push(@symbols,[$addr,$len,$source]) if $addr && $len;
        }
    } else {
        telthemloud 'Unsupported mode: <$mode>';
        return;
    }

    @symbols = sort {$a->[0] <=> $b->[0]} @symbols;
    for my $i(0..scalar(@symbols)-2) {
        my ($addr,$len,$source) = @{$symbols[$i]};
        next if $len;
        my ($addr2,$len2,$source2) = @{$symbols[$i+1]};
        $symbols[$i]->[1] = $addr2-$addr;
    }
    gdb_cached('branch-analyze-mode', $mode);
    unbusy;
    return 1;
}

sub analyze_data {
    my $mode = shift;

    return unless @samples;
    return telthemloud "Samples type mismatch: <$samples_type>" unless ($samples_type == 2);
    return unless init_symbols($mode);

    my @res=();
    my $m = 0;
    my ($i,$d0,$l) = (0,@{$samples[0]});
    my ($I,$D0,$L,$S) = (0,@{$symbols[0]});
    my ($d1,$D1) = ($d0+$l-1,$D0+$L-1);
    my ($ist,$n,$N) = (0,0,0);
    while (($i<scalar(@samples)) && ($I<scalar(@symbols))) {
        if ($d0 > $D1) {
            if ($N) {
                push(@res,[$S,0,$N,$D0,$D1,$ist]); $N = 0; $m++;
            }
            $I++; ($D0,$L,$S)=@{$symbols[$I]}; $D1=$D0+$L-1;
            next;
        } elsif ($d1 < $D0) {
            push(@res,["unknown-1",0,$l,$d0,$d1,$i]); $n = 0; $m++;
            last unless $i < scalar(@samples)-1;
            $i++; ($ist,$d0,$l)=($i,@{$samples[$i]}); $d1=$d0+$l-1;
            next;
        } elsif ($d0 < $D0) {
            push(@res,["unknown-2",0,$D0-$d0,$d0,$D0-1,$i]); $n = 0; $m++;
            $d0 = $D0; $l = $d1-$d0+1;
            next;
        } elsif ($d1 <= $D1) {
            $N += $d1-$d0+1; $n = 0;
            last unless $i < scalar(@samples)-1;
            $i++; ($d0,$l)=@{$samples[$i]}; $d1=$d0+$l-1;
            next;
        } else {
            $N += $D1-$d0+1;
            push(@res,[$S,0,$N,$D0,$D1,$ist]); $N = 0; $m++;
            $d0 = $D1+1; $l = $d1-$d0+1; $n = $l;
            $ist = $i;
            next;
        }
    }
    if ($N) {
        push(@res,[$S,0,$N,$D0,$D1,$ist]); $m++;
    }
    if ($n) {
        push(@res,['unknown-3',0,$n,$d0,$d1,$ist,$i]); $m++;
        while($i<(scalar(@samples)-1)){
            $i++; ($d0,$l)=@{$samples[$i]}; $d1=$d0+$l-1;
            push(@res,['unknown-4',0,$l,$d0,$d1,$i]); $m++;
        }
    }
    foreach my $arow (@res) {
        my ($source,$pcounts,$counts,$start,$stop,$istart) = @{$arow};
        if($counts){
            no integer;
            $pcounts = 100.0*$counts/($stop-$start+1);
            $arow->[1] = $pcounts;
        }
    }
    return @res;
}

sub analyze_it {
    my $mode = shift;

    return unless @samples;
    return unless init_symbols($mode);
    return analyze_data($mode) unless ($samples_type == 1);

    my $i;
    my $unique = 1;
    @samples = sort { $a <=> $b } @samples;
    # collapse
    for ($i = 1; $i < @samples; $i ++) {
        ($samples[ $i     ] ==
         $samples[ $i - 1 ] and
         $samples[ $i - 1 ] = $unique = 0
        )
    }

    @samples = grep {$_} @samples and &samples_count unless $unique;

    my ($cur_addr,$cur_len,$cur_source) = (0,0,'unknown');
    my ($cnt,$pcnt,$inx) = (0,0.0,0);
    my $next_sym = 0;
    my ($next_addr,$next_len,$next_source) = @{$symbols[0]};
    my @res;
    for ($i = 0; $i < @samples; $i ++) {

        if ($samples[$i] < $next_addr) {
            $cnt ++;
            next;
        }
        if ($cnt) {
            $pcnt = 0.0;
            if ($cur_len) {
                no integer;
                $pcnt = 100.0*$cnt/$cur_len;
            }
            push(@res,[$cur_source,$pcnt,$cnt,$cur_addr,$cur_addr+$cur_len-1,$inx]);
        }
        ($cnt,$inx) = (1,$i);
        ($next_addr,$next_len,$next_source) = (0x7fff_ffff,0,'unknown');
        for (; $next_sym < @symbols; $next_sym++) {
            ($cur_addr,$cur_len,$cur_source) = ($next_addr,$next_len,$next_source);
            ($next_addr,$next_len,$next_source) = @{$symbols[$next_sym]};
            last if $samples[$i] < $next_addr;
        }
    }
    if ($cnt) {
        $pcnt = 0.0;
        if ($cur_len) {
            no integer;
            $pcnt = 100.0*$cnt/$cur_len;
        }
        push(@res,[$cur_source,$pcnt,$cnt,$cur_addr,$cur_addr+$cur_len-1,$inx]);
    }

    return @res;
}

sub show_data {

    busy;
    my @rows =  analyze_it($analyze_mode);
    my $sort_col = $result_tbl->{'sortcol'};
    if($sort_col == 1) {
        @rows = sort {$a->[$sort_col-1] cmp $b->[$sort_col-1]} @rows;
    } else {
        @rows = sort {$a->[$sort_col-1] <=> $b->[$sort_col-1]} @rows;
    }
    if($result_tbl->{'sortdir'} == 1) {
        @rows = reverse(@rows);
    }
    $result_tbl->configure(-state=>'normal');
    my $tdata = $result_tbl->cget("-variable");
    my $rows = $result_tbl->cget("rows");
    my $cols = $result_tbl->cget("cols");
    delete @{$tdata}{map { my $col=$_; map {"$col,$_"}(0..$cols-1)}(1..$rows-1)};
    $tdata->{"0,1"} = ('',"Functions","Modules")[$analyze_mode];
    $tdata->{"0,3"} = ('',"Branch\nCount","Count")[$samples_type];
    $result_tbl->colWidth(2=>(0,0,8)[$samples_type]);
    my $row = 1;
    for my $arow (@rows) {
        my ($source,$pcounts,$counts,$start,$stop,$istart) = @{$arow};
        if($data_filter ne ''){
            if (index(sprintf("$source %15.4g %d %x %x",$pcounts,$counts,$start,$stop),$data_filter)<0) {
                next;
            }
        }
        $tdata->{"$row,0"} = $row;
        $tdata->{"$row,1"} = $source;
        $tdata->{"$row,2"} = sprintf("%15.4g",$pcounts);
        $tdata->{"$row,3"} = $counts;
        $tdata->{"$row,4"} = sprintf("%x",$start);
        $tdata->{"$row,5"} = sprintf("%x",$stop);
        $tdata->{"$row,6"} = $istart;
        $row += 1;
    }
    $result_tbl->configure(-variable=>$tdata,-rows=>$row+1);
    $result_tbl->configure(-state=>'disabled');
    unbusy;
}

sub double_click_result_tbl {
    my $tbl = shift;

    my $row = $tbl->index('active','row');
    return unless $row > 0;
    my $tdata = $tbl->cget("-variable");
    return unless $tdata;
    my $source = $tdata->{"$row,1"};
    my $start = hex $tdata->{"$row,4"};
    my $stop = hex $tdata->{"$row,5"};
    my $istart = $tdata->{"$row,6"};
    return unless $start;
    handle_link($source,$start,$stop,$istart);
}

sub click_result_tbl {
    my $tbl = shift;

    my $row = $tbl->index('active','row');
    my $col = $tbl->index('active','col');
    return unless($col > 0) &&($row <= 0);
    my $old_sortcol = $tbl->{'sortcol'};
    my $sortdir = $tbl->{'sortdir'};
    if($tbl->{'sortcol'} == $col) {
        $tbl->{'sortdir'} =($tbl->{'sortdir'}+1) % 2;
    }
    $tbl->{'sortcol'} = $col;
    show_data();
}

sub get_state {

    my %state = (elapsed_secs=>undef,
                 samples=>undef,
                 running=>undef
                );
    my $s = gdb_exec_quiet "symm-profiler Vi";
    return \%state unless $s && $s =~ /^Tcover/;
    if ($s =~ /elapsed secs\s+0x(\w+)\s/) {
        $state{elapsed_secs} = hex $1;
    }
    if ($s =~ /insts count\s+0x(\w+)\s/) {
        $state{samples} = hex $1;
    }
    if ($s =~ /running\s+0x(\w+)\s/) {
        $state{running} = hex $1;
    }
    return \%state;
}

sub online_collect {

    gdb_cached 'is-alive' or return telthemloud 'No Active Debugger';

    if ($online_collect ne 'Read') {
        $online_collect  = 'Read';
        return;
    }

    my ($start,$end) = (0,0);
    busy;

    my @targets = ($multi_dir ?
#                    (gdb_exec_quiet ("info symmetrix-targets") =~ /\"(.*)\"/g) :
                   target_symmetrix_list() :
                   (''));

    $online_collect = 'Stop';
    $samples_type = 0;
    @samples = ();

    for my  $target (@targets) {
        if ($target) {
#             gdb_exec_quiet ("target symmetrix $target");
            target_symmetrix_chdir( $target, 1 ) ;
        }
        while (1) {
            my $cmd = sprintf "symm-profiler Vn:%x:1000", $start;
            my $s = gdb_exec_quiet $cmd;
            if ($s =~ s/^\s*Tcover[^\n]*\n//) {
                if ($samples_type && ($samples_type != 1)) {
                    telme ("symm-profiler samples type mismatch: <$samples_type>");
                    last;
                }
                $samples_type = 1;
                my $n = @samples;
                push @samples, map {hex} split(' ',$s);
                &samples_count;
                last if @samples < ($n + 50);
                $start = $samples[-1] + 1;
                last if $end and $start > $end;
                last if $online_collect eq 'Read';
            } elsif ($s =~ s/^\s*TCpair[^\n]*\n//) {
                if ($samples_type && ($samples_type != 2)) {
                    telme ("symm-profiler samples type mismatch: <$samples_type>");
                    last;
                }
                $samples_type = 2;
                my $n = @samples;
                push @samples, map { my @r = map {hex} split ',',$_; \@r } split(' ',$s);
                samples_count();
                last if @samples < ($n + 50);
                my $i=0;
                my ($addr,$len) = @{$samples[-1]};
                $start = $addr+$len;

            } else {
                telme ("symm-profiler Vn:$start:1000 returned:\n$s");
                last;
            }
        }
    }
    $online_collect = 'Read';
    unbusy;
}

sub handle_link {
    my ($source,$start,$end,$istart) = @_;

    busy;

    $_ = gdb_exec_quiet sprintf "info line *0x%x", $start;
    my ($file) = /\"(.*?)\"/;
    my ($line) = /^Line (\d+)/ if $analyze_mode==1;
    if ($file) {
        hook_run 'mark-branchp-points', $file, $line, \@samples, $istart, $samples_type;
    } else {
        telthemloud "cannot determine filename";
    }

    unbusy;
}
